home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol061 / qsort.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-13  |  2.8 KB  |  37 lines
  1. 50000 REM QUICKER SORT 03/11/82 VER: 1
  2. 50020 REM by W. Pickett
  3. 50040 REM Internal sort for array - string or numeric
  4. 50060 REM This example sorts "ARRAY$" in ascending order
  5. 50080 REM Variables used and maybe needing renaming are:
  6. 50100 REM  S.AL%  S.I1%  S.I2%  S.IS%  S.LL%  S.LS%  S.SL%  S.SP%  S.UL%  S.US%
  7. 50120 REM Uses stack - "S.SP%" - which requires space and is dim in subroutine
  8. 50140 CLS: T1$ = TIME$: F! = FRE(0)
  9. 50160 TEST% = 50 ' Set length of test array$ for example of QSORT ****
  10. 50180 GOSUB 50700 ' Initialize test array - "ARRAY$"
  11. 50200 T3$ = TIME$:F2! = FRE(0)
  12. 50220 IF S.AL% < 100 THEN FOR I = 1 TO S.AL%:PRINT ARRAY$(I) "  ";:NEXT I:PRINT
  13. 50240 GOSUB 50380 ' Call to sort subroutine
  14. 50260 IF S.AL% < 100 THEN FOR I = 1 TO S.AL%:PRINT ARRAY$(I) "  ";:NEXT I:PRINT
  15. 50280 PRINT "SORT COMPLETE" : PRINT T1$ " " T3$ " " TIME$ " " F! " " F2! " " FRE(0) " " FRE("") TIME$:
  16. 50300 END
  17. 50320 REM *******************************************
  18. 50340 REM ********* QUICKER SORT SUBROUTINE *********
  19. 50360 REM *********                         *********
  20. 50380 S.AL% = TEST% ' Limit of array to be sorted **** REQUIRED FOR SORT ****
  21. 50400 DIM S.SP%(CINT(LOG(S.AL%)/.346574),2) ' If sort is to be called more than once, `DIM' the stack `S.SP%' for the largest size of the array outside the sort
  22. 50420 S.IS% = 0: S.LL% = 1: S.UL% = S.AL%: GOTO 50540
  23. 50440 SWAP ARRAY$(S.SL%),ARRAY$(S.LL%):IF S.SL% > S.UL%-2 THEN S.UL% = S.SL%-1 ELSE IF S.SL% < S.LL%+2 THEN S.LL% = S.LL%+1 ELSE S.IS% = S.IS%+1: S.SP%(S.IS%,1)=S.LL%: S.SP%(S.IS%,2) = S.SL%-1: S.LL%=S.SL%+1
  24. 50460 GOTO 50540
  25. 50480 FOR S.I1% = S.LL% + 1 TO S.UL%: FOR S.I2% = S.LL% TO S.I1%: IF ARRAY$(S.I1%) < ARRAY$(S.I2%) THEN SWAP ARRAY$(S.I1%),ARRAY$(S.I2%)
  26. 50500 NEXT S.I2%: NEXT S.I1%
  27. 50520 IF S.IS% = 0 THEN RETURN ELSE S.LL% = S.SP%(S.IS%,1): S.UL%=S.SP%(S.IS%,2): S.IS% = S.IS%-1
  28. 50540 IF S.UL% - S.LL% <= 9 THEN 50480 ELSE S.LS% = S.LL%: S.US% = S.UL% + 1: SWAP ARRAY$(S.LL%),ARRAY$(INT((S.US%-S.LS%)/2)+S.LL%)
  29. 50560 IF S.US% = S.LS%+1 THEN S.SL% = S.LS%: GOTO 50440 ELSE S.LS% = S.LS% + 1: IF ARRAY$(S.LS%) <= ARRAY$(S.LL%) THEN 50600
  30. 50580 IF S.US% = S.LS% + 1 THEN S.SL% = S.LS%-1: GOTO 50440 ELSE S.US% = S.US% - 1: IF ARRAY$(S.US%) >= ARRAY$(S.LL%) THEN 50580 ELSE SWAP ARRAY$(S.LS%),ARRAY$(S.US%): GOTO 50560
  31. 50600 IF S.US% = S.LS% + 1 THEN S.SL% = S.LS%: GOTO 50440 ELSE S.US% = S.US% - 1: IF ARRAY$(S.US%) >= ARRAY$(S.LL%) THEN 50560
  32. 50620 IF S.US% = S.LS% + 1 THEN S.SL% = S.US%: GOTO 50440 ELSE S.LS% = S.LS% + 1: IF ARRAY$(S.LS%) <= ARRAY$(S.LL%) THEN 50620 ELSE SWAP ARRAY$(S.LS%),ARRAY$(S.US%): GOTO 50600
  33. 50640 END '******** End of quicker sort subroutine **
  34. 50660 REM *******************************************
  35. 50680 REM Initialize array for test of sort
  36. 50700 DIM ARRAY$(TEST%):FOR I = 1 TO TEST%:ARRAY$(I)="A"+STR$(TEST%-I): NEXT I: RETURN
  37.